/* -*- coding: utf-8 -*- */
/* GNU Emacs case conversion functions.

Copyright (C) 1985, 1994, 1997-1999, 2001-2017 Free Software Foundation,
Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>

#include "lisp.h"
#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "syntax.h"
#include "composite.h"
#include "keymap.h"

enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP,
		  /* Only for internal use: */ CASE_NO_ACTION};

/* State for casing individual characters.  */
struct casing_context
{
  /* A char-table with title-case character mappings or nil.  Non-nil implies
     flag is CASE_CAPITALIZE or CASE_CAPITALIZE_UP.  */
  Lisp_Object titlecase_char_table;

  /* The unconditional special-casing Unicode property char tables for upper
     casing, lower casing and title casing respectively.  */
  Lisp_Object specialcase_char_tables[3];

  /* User-requested action.  */
  enum case_action flag;

  /* If true, the function operates on a buffer as opposed to a string
     or character.  When run on a buffer, syntax_prefix_flag_p is
     taken into account when determining whether the context is within
     a word.  */
  bool inbuffer;

  /* Whether the context is within a word.  */
  bool inword;

  /* Determines which special casing rules need to be applied as well as tracks
     state for some of the transformations.*/
  enum {
    /* No special casing rules need to be applied. */
    SPECIAL_NONE,

    /* In Dutch, ‘ij’ is a digraph and when capitalised the whole thing is upper
       cased.  Unicode has ‘ĳ’ and ‘Ĳ’ (with proper casing mappings) but they
       aren’t always used so we cannot/should not rely on them.

       Note that rule for capitalising ‘ij’ as a single letter is not present in
       Unicode 9.0’s SpecialCasing.txt.  On the flip side, Firefox implements
       this as well so we’re not completely alone.

       There are words where ‘ij’ are two separate letters (such as bijectie or
       bijoux) in which case the capitalisation rules do not apply.  I (mina86)
       have googled this a little and couldn’t find a Dutch word which beings
       with ‘ij’ that is not a digraph so we should be in the clear since we
       only care about the initial. */
    /* Apply Dutch rules for capitalising ‘ij’. */
    SPECIAL_NL,
    /* As above and the previous character was upcased ‘i’ so if we now see ‘j’
       it needs to be upcased as well. */
    SPECIAL_NL_UPCASE_J,

    /* Handle Azerbaijani and Turkish dotted and dotless i. */
    SPECIAL_TR,

    /* Apply Lithuanian rules for i’s and j’s tittle. */
    SPECIAL_LT,
    /* As above plus look out for combining dot above to delete. */
    SPECIAL_LT_DEL_DOT_ABOVE,
    /* As above plus look out for diacritics combining above because
       we may need to inject dot above before them. */
    SPECIAL_LT_INS_DOT_ABOVE,

    /* Flags for Irish word capitalising rules.  Those are insane, see
       https://bugzilla.mozilla.org/show_bug.cgi?id=1018805 and
       https://bugzilla.mozilla.org/show_bug.cgi?id=1014639 for reference. */
    /* Irish handling enabled; we are lower-casing words. */
    SPECIAL_GA_LC,
    /* Irish handling enabled; we are upper-casing words or capitalising. */
    SPECIAL_GA_UC,
    /* Upper-case next character. */
    SPECIAL_GA_UC_NEXT,
    /* We’re in the middle of a potential ‘bhf’ or ‘bhF’ triplet. */
    SPECIAL_GA_TRIPLET_B = 'b',
    /* We’re in the middle of a potential ‘n-{v}’ triplet. */
    SPECIAL_GA_TRIPLET_N = 'n',
    /* We’re in the middle of a potential triplet starting with ‘ts’ or ‘tS’. */
    SPECIAL_GA_TRIPLET_T = 't'
    /* Yes, it matters that the last three flags equal the characters for b,
       n or t. */
  } special;
};

/* Initialize CTX structure for casing characters.  */
static void
prepare_casing_context (struct casing_context *ctx,
			enum case_action flag, bool inbuffer)
{
  Lisp_Object lang;

  ctx->flag = flag;
  ctx->inbuffer = inbuffer;
  ctx->inword = false;
  ctx->titlecase_char_table
    = (flag < CASE_CAPITALIZE ? Qnil
       : uniprop_table (Qtitlecase));
  ctx->specialcase_char_tables[CASE_UP]
    = (flag == CASE_DOWN ? Qnil
       : uniprop_table (Qspecial_uppercase));
  ctx->specialcase_char_tables[CASE_DOWN]
    = (flag == CASE_UP ? Qnil
       : uniprop_table (Qspecial_lowercase));
  ctx->specialcase_char_tables[CASE_CAPITALIZE]
    = (flag < CASE_CAPITALIZE ? Qnil
       : uniprop_table (Qspecial_titlecase));

  /* If the case table is flagged as modified, rescan it.  */
  if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
    Fset_case_table (BVAR (current_buffer, downcase_table));

  if (inbuffer && flag >= CASE_CAPITALIZE)
    SETUP_BUFFER_SYNTAX_TABLE ();	/* For syntax_prefix_flag_p.  */

  lang = BVAR(current_buffer, language);
  if (STRINGP (lang) && SCHARS (lang) >= 2)
    switch ((SREF(lang, 0) << 8) | SREF(lang, 1) | 0x2020u) {
    case ('n' << 8) | 'l':  /* Dutch */
      if ((int) flag >= (int) CASE_CAPITALIZE)
	ctx->special = SPECIAL_NL;
      break;
    case ('t' << 8) | 'r':  /* Turkish */
    case ('a' << 8) | 'z':  /* Azerbaijani */
      ctx->special = SPECIAL_TR;
      break;
    case ('l' << 8) | 't':  /* Lithuania */
      ctx->special = SPECIAL_LT;
      break;
    case ('g' << 8) | 'a':  /* Irish */
      ctx->special = flag == CASE_DOWN ? SPECIAL_GA_LC : SPECIAL_GA_UC;
    }
}

/* Normalise CFG->flag and return CASE_UP, CASE_DOWN, CASE_CAPITALIZE or
   CASE_NO_ACTION.  The latter if CFG->flag is CASE_CAPITALIZE_UP and we are
   inside of a word. */
static enum case_action
normalise_flag (struct casing_context *ctx)
{
  /* Normalise flag so its one of CASE_UP, CASE_DOWN or CASE_CAPITALIZE. */
  switch (ctx->flag) {
  case CASE_CAPITALIZE:
    return ctx->inword ? CASE_DOWN : CASE_CAPITALIZE;
  case CASE_CAPITALIZE_UP:
    return ctx->inword ? CASE_NO_ACTION : CASE_CAPITALIZE;
  default:
    return ctx->flag;
  }
}

struct casing_str_buf
{
  unsigned char data[max (6, MAX_MULTIBYTE_LENGTH)];
  unsigned char len_chars;
  unsigned char len_bytes;
};

enum {
  RES_NOT_TOUCHED = -2,
  RES_NO_CHANGE = -1,
  RES_CHANGED = 0,
};

/* Based on CTX and FLAG, case character CH.  If BUF is NULL, return cased
   character.  Otherwise, if BUF is non-NULL, save result in it and return
   RES_CHANGED if the character changed or RES_NO_CHANGE if it didn’t.

   FLAG may be one of CASE_UP, CASE_DOWN, CASE_CAPITALIZE (title-case if
   possible, upper-aces otherwise) or CASE_NO_ACTION.  CTX->inword is not taken
   into account when interpreting FLAG (it may be taken into account for other
   decisions though).

   Since meaning of return value depends on arguments, it’s more convenient to
   use case_single_character or case_characters instead.  */
static int
case_character_impl (struct casing_str_buf *buf,
		     struct casing_context *ctx, enum case_action flag, int ch)
{
  Lisp_Object prop;
  int cased;

  /* Handle Dutch ij.  Note that SPECIAL_NL and SPECIAL_NL_UPCASE_J implies that
     ctx->flag ≥ CASE_CAPITALIZE.  This has to be handled prior to flag ==
     CASE_NO_ACTION check or otherwise we won’t handle ctx->flag ==
     CASE_CAPITALIZE_UP correctly. */
  if (ctx->special == SPECIAL_NL && ch == 'i' && !ctx->inword)
    {
      ctx->special = SPECIAL_NL_UPCASE_J;
      ctx->inword = true;
      cased = 'I';
      goto done;
    }
  else if (ctx->special == SPECIAL_NL_UPCASE_J)
    {
      ctx->special = SPECIAL_NL;
      if (ch == 'j')
	{
	  cased = 'J';
	  goto done;
	}
    }

  /* Update inword state */
  ctx->inword = SYNTAX (ch) == Sword &&
    (!ctx->inbuffer || ctx->inword || !syntax_prefix_flag_p (ch));

  if (flag == CASE_NO_ACTION)
    {
      cased = ch;
      goto done;
    }

  /* Look through the special casing entries.  */
  if (buf && !NILP (ctx->specialcase_char_tables[flag]))
    {
      prop = CHAR_TABLE_REF (ctx->specialcase_char_tables[flag], ch);
      if (STRINGP (prop))
        {
          struct Lisp_String *str = XSTRING (prop);
          if (STRING_BYTES (str) <= sizeof buf->data)
	    {
	      buf->len_chars = str->size;
	      buf->len_bytes = STRING_BYTES (str);
	      memcpy (buf->data, str->data, buf->len_bytes);
	      return RES_CHANGED;
	    }
        }
    }

  /* Handle simple, one-to-one case.  */
  if (flag == CASE_DOWN)
    cased = downcase (ch);
  else
    {
      bool cased_is_set = false;
      if (!NILP (ctx->titlecase_char_table))
	{
	  prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch);
	  if (CHARACTERP (prop))
	    {
	      cased = XFASTINT (prop);
	      cased_is_set = true;
	    }
	}
      if (!cased_is_set)
	cased = upcase (ch);
    }

  /* And we’re done.  */
 done:
  if (!buf)
    return cased;
  buf->len_chars = 1;
  buf->len_bytes = CHAR_STRING (cased, buf->data);
  return cased == ch ? -1 : 0;
}

/* Based on CTX, case character CH accordingly.  Update CTX as necessary.
   Return cased character.

   Special casing rules (such as upcase(ﬁ) = FI) are not handled.  For
   characters whose casing results in multiple code points, the character is
   returned unchanged. */
static inline int
case_single_character (struct casing_context *ctx, int ch)
{
  enum case_action flag = normalise_flag (ctx);
  return case_character_impl (NULL, ctx, flag, ch);
}

/* In Greek, lower case sigma has two forms: one when used in the middle and one
   when used at the end of a word.  Below is to help handle those cases when
   casing.

   The rule does not conflict with any other casing rules so while it is
   a conditional one, it is independent of language.  */

enum { GREEK_CAPITAL_LETTER_SIGMA = 0x03A3 }; /* Σ */
enum { GREEK_SMALL_LETTER_FINAL_SIGMA = 0x03C2 }; /* ς */
enum { GREEK_SMALL_LETTER_SIGMA = 0x03C3 }; /* σ */

/* Save in BUF result of casing character CH if Greek casing rules apply.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Greek rules did not apply, no changes were
   made and other casing rules should be tried.  Otherwise, meaning of return
   values is the same as in case_characters function. */
static int
maybe_case_greek (struct casing_str_buf *buf, struct casing_context *ctx,
		  enum case_action flag, int ch, const char *next) {
  if (flag != CASE_DOWN || ch != GREEK_CAPITAL_LETTER_SIGMA)
    return RES_NOT_TOUCHED;

  ch = (ctx->inword && (!next || SYNTAX (STRING_CHAR (next)) != Sword))
    ? GREEK_SMALL_LETTER_FINAL_SIGMA : GREEK_SMALL_LETTER_SIGMA;
  buf->len_bytes = CHAR_STRING (ch, buf->data);
  buf->len_chars = 1;
  ctx->inword = true;
  return RES_CHANGED;
}

/* Azerbaijani and Turkish have dotless and dotted i.  An upper case of i is
   İ while lower case of I is ı. */

enum {
  LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE = 0x130, /* İ */
  LATIN_SMALL_LETTER_DOTLESS_I = 0x131, /* ı */
  COMBINING_DOT_ABOVE = 0x307,
};

/* Save in BUF result of casing character CH if Turkic casing rules apply.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Turkic rules did not apply, no changes were
   made and other casing rules should be tried.  Otherwise, meaning of return
   values is the same as in case_characters function. */
static int
maybe_case_turkic (struct casing_str_buf *buf, struct casing_context *ctx,
		   enum case_action flag, int ch, const char *next) {
  bool dot_above = false;
  int cased = ch;

  if (flag == CASE_NO_ACTION || ctx->special != SPECIAL_TR)
    return RES_NOT_TOUCHED;

  switch (ch) {
  case 'I':
    if (flag == CASE_DOWN)
      {
	dot_above = next && STRING_CHAR (next) == COMBINING_DOT_ABOVE;
	cased = dot_above ? 'i' : LATIN_SMALL_LETTER_DOTLESS_I;
      }
    break;

  case 'i':
    if (flag == CASE_UP || flag == CASE_CAPITALIZE)
      cased = LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE;
    break;

  case LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE:
    if (flag == CASE_DOWN)
      cased = 'i';
    break;

  case LATIN_SMALL_LETTER_DOTLESS_I:
    if (flag == CASE_UP || flag == CASE_CAPITALIZE)
      cased = 'I';
    break;

  default:
    return RES_NOT_TOUCHED;
  }

  ctx->inword = true;
  buf->len_chars = 1;
  buf->len_bytes = CHAR_STRING (cased, buf->data);
  if (dot_above)
    return CHAR_BYTES (COMBINING_DOT_ABOVE);
  else
    return ch == cased ? RES_NO_CHANGE : RES_CHANGED;
}

/* Lithuanian retains tittle in lower case i and j when there are more
   accents above those letters. */

enum {
  LATIN_CAPITAL_LETTER_I_WITH_GRAVE  = 0x0CC, /* Ì */
  LATIN_CAPITAL_LETTER_I_WITH_ACUTE  = 0x0CD, /* Í */
  LATIN_CAPITAL_LETTER_I_WITH_TILDE  = 0x128, /* Ĩ */
  LATIN_CAPITAL_LETTER_I_WITH_OGONEK = 0x12E, /* Į */
  LATIN_SMALL_LETTER_I_WITH_OGONEK   = 0x12F, /* į */
  COMBINING_GRAVE_ABOVE = 0x300,
  COMBINING_ACUTE_ABOVE = 0x301,
  COMBINING_TILDE_ABOVE = 0x303,
  COMBINING_OGONEK      = 0x328
};

/* Save in BUF result of casing character CH if Lithuanian casing rules apply.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Lithuanian rules did not apply, no changes
   were made and other casing rules should be tried.  Otherwise, meaning of
   return values is the same as in case_characters function. */
static int
maybe_case_lithuanian (struct casing_str_buf *buf, struct casing_context *ctx,
		       enum case_action flag, int ch)
{
  switch (ctx->special) {
  case SPECIAL_LT:
    break;

  case SPECIAL_LT_DEL_DOT_ABOVE:
    /* When upper-casing i or j, a combining dot above that follows it must be
       removed.  This is true even if there’s a combining ogonek in between.
       But, if there’s another character combining above in between, combining
       dot needs to stay (since the dot will be rendered above the other
       diacritic). */
    switch (ch) {
    case COMBINING_DOT_ABOVE:
      buf->len_chars = buf->len_bytes = 0;
      ctx->special = SPECIAL_LT;
      return RES_CHANGED;
    case COMBINING_GRAVE_ABOVE:
    case COMBINING_ACUTE_ABOVE:
    case COMBINING_TILDE_ABOVE:
      ctx->special = SPECIAL_LT;
      return RES_NOT_TOUCHED;
    case COMBINING_OGONEK:
      return RES_NOT_TOUCHED;
    default:
      ctx->special = SPECIAL_LT;
    }
    break;

  case SPECIAL_LT_INS_DOT_ABOVE:
    /* When lower-casing I or J, if the letter has any accents above,
       a combining dot above must be added before them.  If we are here, it
       means that we have lower cased I or J and we’re now on the lookout for
       accents combining above. */
    switch (ch) {
    case COMBINING_GRAVE_ABOVE:
    case COMBINING_ACUTE_ABOVE:
    case COMBINING_TILDE_ABOVE:
      buf->len_chars = 2;
      buf->len_bytes = CHAR_STRING (COMBINING_DOT_ABOVE, buf->data);
      buf->len_bytes += CHAR_STRING (ch, buf->data + buf->len_bytes);
      ctx->special = SPECIAL_LT;
      return RES_CHANGED;
    case COMBINING_OGONEK:
      return RES_NOT_TOUCHED;
    default:
      ctx->special = SPECIAL_LT;
    }
    break;

  default:
    return RES_NOT_TOUCHED;
  }

  switch (flag) {
  case CASE_UP:
  case CASE_CAPITALIZE:
    if (ch == 'i' || ch == 'j')
      {
	buf->data[0] = ch ^ ('i' ^ 'I');
	buf->len_bytes = 1;
      }
    else if (ch == LATIN_SMALL_LETTER_I_WITH_OGONEK)
      buf->len_bytes = CHAR_STRING (LATIN_CAPITAL_LETTER_I_WITH_OGONEK,
				    buf->data);
    else
      break;
    buf->len_chars = 1;
    /* Change the state so we’re on the lookout for combining dot above. */
    ctx->special = SPECIAL_LT_DEL_DOT_ABOVE;
    return RES_CHANGED;

  case CASE_DOWN:
    /* Turning I or J to lower case requires combining dot above to be included
       IF there are any other characters combining above present.  This is so
       that the tittle is preserved. */
    switch (ch) {
    case LATIN_CAPITAL_LETTER_I_WITH_GRAVE:
      ch = 0x80;  /* U+300, "\xCC\x80", combining grave accent */
      goto has_accent;
    case LATIN_CAPITAL_LETTER_I_WITH_ACUTE:
      ch = 0x81;  /* U+301, "\xCC \x81", combining acute accent */
      goto has_accent;
    case LATIN_CAPITAL_LETTER_I_WITH_TILDE:
      ch = 0x83;  /* U+303, "\xCC\x83", combining tilde */
    has_accent:
      memcpy (buf->data, "i\xCC\x87\xCC", 4);
      buf->data[4] = ch;
      buf->len_chars = 3;
      buf->len_bytes = 5;
      return RES_CHANGED;

    case 'I':
    case 'J':
      buf->data[0] = ch ^ ('i' ^ 'I');
      buf->len_bytes = 1;
      if (false)
    case LATIN_CAPITAL_LETTER_I_WITH_OGONEK:
	buf->len_bytes = CHAR_STRING (LATIN_SMALL_LETTER_I_WITH_OGONEK,
				      buf->data);
      buf->len_chars = 1;
      /* Change the state so we’re on the lookout for diacritics combining
	 above.  If one is found, we need to add combining dot above. */
      ctx->special = SPECIAL_LT_INS_DOT_ABOVE;
      return RES_CHANGED;
    }
    break;
  }

  return RES_NOT_TOUCHED;
}

/* The naïve method works for ASCII letters but also non-ASCII Irish
   vowels and second byte in UTF-8 representation of those vowels. */
static int irish_upcase(int ch) { return ch & ~('a' ^ 'A'); }
static int irish_downcase(int ch) { return ch | ('a' ^ 'A'); }

/* A byte starting two-byte sequence of non-ASCII Irish vowels. */
#define GA_UTF8_FIRST_BYTE 0xC3

/* Classifies UTF-8 encoded character at *CH as Irish vowel or not. */
static enum {
  GA_NOT_VOWEL = 0,
  GA_UC_VOWEL = 1,
  GA_LC_VOWEL = 2
} is_irish_vowel(const unsigned char *ch) {
  switch (*ch) {
  case 'A': case 'E': case 'I': case 'O': case 'U':
    return GA_UC_VOWEL;
  case 'a': case 'e': case 'i': case 'o': case 'u':
    return GA_LC_VOWEL;
  case GA_UTF8_FIRST_BYTE:
    switch (ch[1]) {
    case 0x81:  /* C3 81 → U+00C1 → Á */
    case 0x89:  /* C3 89 → U+00C9 → É */
    case 0x8D:  /* C3 8D → U+00CD → Í */
    case 0x93:  /* C3 93 → U+00D3 → Ó */
    case 0x9A:  /* C3 9A → U+00DA → Ú */
      return GA_UC_VOWEL;
    case 0xA1:  /* C3 A1 → U+00E1 → á */
    case 0xA9:  /* C3 A9 → U+00E9 → é */
    case 0xAD:  /* C3 AD → U+00ED → í */
    case 0xB3:  /* C3 B3 → U+00F3 → ó */
    case 0xBA:  /* C3 BA → U+00FA → ú */
      return GA_LC_VOWEL;
    }
  }
  return GA_NOT_VOWEL;
}

/* Return whether *CH is an upper-case Irish vowel encoded in UTF-8. */
static bool
is_irish_uc_vowel(const char *ch) {
  return is_irish_vowel(ch) == GA_UC_VOWEL;
}

/* Return whether *CH is an lower-case Irish vowel encoded in UTF-8. */
static bool
is_irish_lc_vowel(const char *ch) {
  return is_irish_vowel(ch) == GA_LC_VOWEL;
}

/* Save in BUF result of casing character CH if Irish casing rules apply.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   FLAG is a normalised flag (as returned by normalise_flag function).

   Return -2 (RES_NOT_TOUCHED) if Irish rules did not apply, no changes
   were made and other casing rules should be tried.  Otherwise, meaning of
   return values is the same as in case_characters function. */
static int
maybe_case_irish (struct casing_str_buf *buf, struct casing_context *ctx,
		  enum case_action flag, int ch, const unsigned char *next) {
  unsigned n;

  switch (ctx->special) {
  case SPECIAL_GA_LC:
    /* We are lower-casing words and Irish rules are enabled.  See
       https://bugzilla.mozilla.org/show_bug.cgi?id=1018805 for reference.  The
       rules are:

         t{V} → t-{v}
         n{V} → n-{v}

       {V} denotes upper-case Irish vowel and {v} denotes a lower-case one. */

    if (!next ||
	ctx->inword ||
	(ch != 't' && ch != 'n') ||
	!is_irish_uc_vowel(next))
      return RES_NOT_TOUCHED;

    ctx->inword = true;
    buf->len_chars = 3;
    buf->data[0] = ch;
    buf->data[1] = '-';
    if (*next < 0x80) {
      buf->data[2] = irish_downcase(next[0]);
      buf->len_bytes = 3;
      return 1;
    } else {
      buf->data[2] = next[0];
      buf->data[3] = irish_downcase(next[1]);
      buf->len_bytes = 4;
      return 2;
    }

  case SPECIAL_GA_UC:
    /* We are upper-casing or capitalising words and Irish rules are enabled.
       See https://bugzilla.mozilla.org/show_bug.cgi?id=1014639 for
       reference. The rules are:

	 h{V}  → h{V}
	 n{V}  → n{V}
	 t{V}  → t{V}

	 bp    → bP
	 bP    → bP
	 dt    → dT
	 dT    → dT
	 gc    → gC
	 gC    → gC
	 mb    → mB
	 mB    → mB
	 nd    → nD
	 nD    → nD
	 ng    → nG
	 nG    → nG

	 bhf   → bhF
	 bhF   → bhF

	 n-{v} → n{V}
	 t-{v} → t{V}

	 tSL   → tSL
	 tSl   → tSL
	 tsl   → tSL
	 tSN   → tSN
	 tsn   → tSN
	 tSn   → tSN
	 tSR   → tSR
	 tSr   → tSR
	 tsr   → tSR
	 tS{V} → tS{V}
	 tS{v} → tS{V}
	 ts{v} → tS{V}

       {V} denotes upper-case Irish vowel and {v} denotes a lower-case one. */

    if (!next || ctx->inword || ch < 'a' || ch > 'z')
      return RES_NOT_TOUCHED;

    n = irish_upcase(*next);
    if (((ch == 'h' || ch == 'n' || ch == 't') && is_irish_uc_vowel(next)) ||
	(ch == 'b' && n == 'P') ||
	(ch == 'd' && n == 'T') ||
	(ch == 'g' && n == 'C') ||
	(ch == 'm' && n == 'B') ||
	(ch == 'n' && n == 'D') ||
	(ch == 'n' && n == 'G'))
      {
	ctx->inword = true;
	ctx->special = SPECIAL_GA_UC_NEXT;
	buf->data[0] = ch;
	buf->len_chars = 1;
	buf->len_bytes = 1;
	return RES_NO_CHANGE;
      }

    if ((ch == 'b' && *next == 'h') || (ch == 't' && n == 'S') ||
	(ch == 't' && *next == '-') || (ch == 'n' && *next == '-'))
      {
	/* We can only look at two characters at a time but here we need to make
	   a decision based on a 3-character sequence.

	   Let’s return empty string for now, remember the current character and
	   when we’ll be dealing with the next character we’ll be able to see
	   three characters.

	   Downside of this approach is that we cannot always correctly mark
	   buffer as changed.  Namely, ‘bhF’ triplet does not need to be changed
	   but sadly we'll mark this as modified. */
	ctx->inword = true;
	ctx->special = ch;
	buf->len_chars = 0;
	buf->len_bytes = 0;
	return RES_CHANGED;
      }

    return RES_NOT_TOUCHED;

  case SPECIAL_GA_UC_NEXT:
    ctx->special = SPECIAL_GA_UC;
    n = irish_upcase(ch);
    buf->len_bytes = CHAR_STRING (n, buf->data);
    buf->len_chars = 1;
    return n == ch ? RES_NO_CHANGE : RES_CHANGED;

  case SPECIAL_GA_TRIPLET_B:
  case SPECIAL_GA_TRIPLET_N:
  case SPECIAL_GA_TRIPLET_T:
    /* We’re here after encountering a possible beginning of a three-character
       sequence that needs to be handled.  Those are:

	 bhf   → bhF
	 bhF   → bhF

	 n-{v} → n{V}
	 t-{v} → t{V}

	 tSL   → tSL
	 tSl   → tSL
	 tsl   → tSL
	 tSN   → tSN
	 tsn   → tSN
	 tSn   → tSN
	 tSR   → tSR
	 tSr   → tSR
	 tsr   → tSR
	 tS{V} → tS{V}
	 tS{v} → tS{V}
	 ts{v} → tS{V} */

    if (*next)
      switch (ch) {
      case '-':  /* ‘n-’ or ‘t-’ prefix. */
	if (is_irish_lc_vowel(next))
	  {
	    buf->data[0] = ctx->special;
	    buf->len_chars = 1;
	    buf->len_bytes = 1;
	    ctx->special = SPECIAL_GA_UC_NEXT;
	    return RES_CHANGED;
	  }
	break;

      case 'h':  /* ‘bh’ prefix */
	if (irish_upcase(*next) == 'F') {
	  ctx->special = SPECIAL_GA_UC;
	  buf->data[0] = 'b';
	  buf->data[1] = 'h';
	  buf->data[2] = 'F';
	  buf->len_chars = 3;
	  buf->len_bytes = 3;
	  return 1;
	}
	break;

      case 's':  /* ‘ts’ prefix. */
	if (*next == 'l' || *next == 'n' || *next == 'r' ||
	    is_irish_lc_vowel(next))
	  goto tSU;
	break;

      case 'S':  /* ‘tS’ prefix. */
	if (*next == 'l' || *next == 'n' || *next == 'r' ||
	    *next == 'L' || *next == 'N' || *next == 'R' ||
	    is_irish_vowel(next))
	  {
	  tSU:
	    /* t{s}{x} → tS{X} */
	    ctx->special = SPECIAL_GA_UC_NEXT;
	    buf->data[0] = 't';
	    buf->data[1] = 'S';
	    buf->len_chars = 2;
	    buf->len_bytes = 2;
	    return RES_CHANGED;
	  }
	break;
      }

    /* Recover from a incorrect guess that it was a triplet. */
    if (ch == '-') {
      ctx->inword = false;
    } else if (ctx->flag == CASE_UP) {
      ch = irish_upcase(ch);
    } else if (ctx->flag == CASE_CAPITALIZE) {
      ch = irish_downcase(ch);
    }

    buf->data[0] = irish_upcase(ctx->special);
    buf->data[1] = ch;
    buf->len_chars = 2;
    buf->len_bytes = 2;
    ctx->special = SPECIAL_GA_UC;
    return RES_CHANGED;
  }

  return RES_NOT_TOUCHED;
}

/* Save in BUF result of casing character CH.

   If not-NULL, NEXT points to the next character in the cased string.  If NULL,
   it is assumed current character is the last one being cased.  This is used to
   apply some rules which depend on proceeding state.

   Return:
   • -1 (RES_NO_CHANGE) if character has not been changed,
   • 0 (RES_CHANGED) if the character has changed or
   • a positive number if the character CH and the one following it (pointed by
     NEXT) map to character saved in BUF.  Returned value is the length in bytes
     of the next character.

   This is like case_single_character but also many-to-many casing rules.  */
static int
case_characters (struct casing_str_buf *buf, struct casing_context *ctx,
		 int ch, const unsigned char *next)
{
  enum case_action flag = normalise_flag (ctx);
  int ret = RES_NOT_TOUCHED;

  switch (ctx->special) {
  case SPECIAL_NONE:
    break;

  case SPECIAL_TR:
    ret = maybe_case_turkic (buf, ctx, flag, ch, next);
    break;

  default:
  /* case SPECIAL_LT: */
  /* case SPECIAL_LT_DEL_DOT_ABOVE: */
  /* case SPECIAL_LT_INS_DOT_ABOVE: */
    ret = maybe_case_lithuanian (buf, ctx, flag, ch);
    break;

  case SPECIAL_GA_LC:
  case SPECIAL_GA_UC:
  case SPECIAL_GA_UC_NEXT:
  case SPECIAL_GA_TRIPLET_B:
  case SPECIAL_GA_TRIPLET_N:
  case SPECIAL_GA_TRIPLET_T:
    ret = maybe_case_irish (buf, ctx, flag, ch, next);
  }

  if (ret == RES_NOT_TOUCHED)
    ret = maybe_case_greek (buf, ctx, flag, ch, next);

  if (ret == RES_NOT_TOUCHED)
    ret = case_character_impl (buf, ctx, flag, ch);

  return ret;
}

static Lisp_Object
do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
{
  int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
		  | CHAR_SHIFT | CHAR_CTL | CHAR_META);
  int ch = XFASTINT (obj);

  /* If the character has higher bits set above the flags, return it unchanged.
     It is not a real character.  */
  if (UNSIGNED_CMP (ch, >, flagbits))
    return obj;

  int flags = ch & flagbits;
  ch = ch & ~flagbits;

  /* FIXME: Even if enable-multibyte-characters is nil, we may manipulate
     multibyte chars.  This means we have a bug for latin-1 chars since when we
     receive an int 128-255 we can't tell whether it's an eight-bit byte or
     a latin-1 char.  */
  bool multibyte = (ch >= 256
		    || !NILP (BVAR (current_buffer,
				    enable_multibyte_characters)));
  if (! multibyte)
    MAKE_CHAR_MULTIBYTE (ch);
  int cased = case_single_character (ctx, ch);
  if (cased == ch)
    return obj;

  if (! multibyte)
    MAKE_CHAR_UNIBYTE (cased);
  return make_natnum (cased | flags);
}

static Lisp_Object
do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj)
{
  /* Verify that ‘data’ is the first member of struct casing_str_buf
     so that when casting char * to struct casing_str_buf *, the
     representation of the character is at the beginning of the
     buffer.  This is why we don’t need a separate struct
     casing_str_buf object, and can write directly to the destination.  */
  verify (offsetof (struct casing_str_buf, data) == 0);

  ptrdiff_t size = SCHARS (obj), n;
  USE_SAFE_ALLOCA;
  if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)
      || INT_ADD_WRAPV (n, sizeof (struct casing_str_buf), &n))
    n = PTRDIFF_MAX;
  unsigned char *dst = SAFE_ALLOCA (n);
  unsigned char *dst_end = dst + n;
  unsigned char *o = dst;

  const unsigned char *src = SDATA (obj);

  n = 0;
  while (size)
    {
      if (dst_end - o < sizeof(struct casing_str_buf))
	string_overflow ();
      int ch = STRING_CHAR_ADVANCE (src);
      int ret = case_characters ((void *)o, ctx, ch, size > 1 ? src : NULL);
      if (ret > RES_CHANGED)
	src += ret;
      size -= ret > RES_CHANGED ? 2 : 1;
      n += ((struct casing_str_buf *)o)->len_chars;
      o += ((struct casing_str_buf *)o)->len_bytes;
    }
  eassert (o <= dst_end);
  obj = make_multibyte_string ((char *) dst, n, o - dst);
  SAFE_FREE ();
  return obj;
}

static Lisp_Object
do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj)
{
  ptrdiff_t i, size = SCHARS (obj);
  int ch, cased;

  obj = Fcopy_sequence (obj);
  for (i = 0; i < size; i++)
    {
      ch = SREF (obj, i);
      MAKE_CHAR_MULTIBYTE (ch);
      cased = case_single_character (ctx, ch);
      if (ch == cased)
	continue;
      MAKE_CHAR_UNIBYTE (cased);
      /* If the char can't be converted to a valid byte, just don't
	 change it.  */
      if (cased >= 0 && cased < 256)
	SSET (obj, i, cased);
    }
  return obj;
}

static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
  struct casing_context ctx;
  prepare_casing_context (&ctx, flag, false);

  if (NATNUMP (obj))
    return do_casify_natnum (&ctx, obj);
  else if (!STRINGP (obj))
    wrong_type_argument (Qchar_or_string_p, obj);
  else if (!SCHARS (obj))
    return obj;
  else if (STRING_MULTIBYTE (obj))
    return do_casify_multibyte_string (&ctx, obj);
  else
    return do_casify_unibyte_string (&ctx, obj);
}

DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
       doc: /* Convert argument to upper case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. ﬁ, are returned unchanged.
See also `capitalize', `downcase' and `upcase-initials'.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_UP, obj);
}

DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
       doc: /* Convert argument to lower case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_DOWN, obj);
}

DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
       doc: /* Convert argument to capitalized form and return that.
This means that each word's first character is converted to either
title case or upper case, and the rest to lower case.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. ﬁ, are returned unchanged.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_CAPITALIZE, obj);
}

/* Like Fcapitalize but change only the initials.  */

DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
       doc: /* Convert the initial of each word in the argument to upper case.
This means that each word's first character is converted to either
title case or upper case, and the rest are left unchanged.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  If argument
is a character, characters which map to multiple code points when
cased, e.g. ﬁ, are returned unchanged.  */)
  (Lisp_Object obj)
{
  return casify_object (CASE_CAPITALIZE_UP, obj);
}

/* Based on CTX, case region in a unibyte buffer from *STARTP to *ENDP.

   Save first and last positions that has changed in *STARTP and *ENDP
   respectively.  If no characters were changed, save -1 to *STARTP and leave
   *ENDP unspecified.

   Always return 0.  This is so that interface of this function is the same as
   do_casify_multibyte_region.  */
static ptrdiff_t
do_casify_unibyte_region (struct casing_context *ctx,
			  ptrdiff_t *startp, ptrdiff_t *endp)
{
  ptrdiff_t first = -1, last = -1;  /* Position of first and last changes.  */
  ptrdiff_t end = *endp;

  for (ptrdiff_t pos = *startp; pos < end; ++pos)
    {
      int ch = FETCH_BYTE (pos);
      MAKE_CHAR_MULTIBYTE (ch);

      int cased = case_single_character (ctx, ch);
      if (cased == ch)
	continue;

      last = pos + 1;
      if (first < 0)
	first = pos;

      MAKE_CHAR_UNIBYTE (cased);
      FETCH_BYTE (pos) = cased;
    }

  *startp = first;
  *endp = last;
  return 0;
}

/* Based on CTX, case region in a multibyte buffer from *STARTP to *ENDP.

   Return number of added characters (may be negative if more characters were
   deleted then inserted), save first and last positions that has changed in
   *STARTP and *ENDP respectively.  If no characters were changed, return 0,
   save -1 to *STARTP and leave *ENDP unspecified.  */
static ptrdiff_t
do_casify_multibyte_region (struct casing_context *ctx,
			    ptrdiff_t *startp, ptrdiff_t *endp)
{
  ptrdiff_t first = -1, last = -1;  /* Position of first and last changes.  */
  ptrdiff_t pos = *startp, pos_byte = CHAR_TO_BYTE (pos), size = *endp - pos;
  ptrdiff_t opoint = PT, added = 0;

  while (size)
    {
      int len_bytes;
      int ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (pos_byte), len_bytes);
      struct casing_str_buf buf;
      int ret = case_characters (
	  &buf, ctx, ch,
	  size > 1 ? BYTE_POS_ADDR (pos_byte + len_bytes) : NULL);
      int len_chars = 1;

      switch (ret) {
      default:
	len_chars += 1;
	/* FALL THROUGH */

      case RES_CHANGED:
	len_bytes += ret;
	len_chars = ret ? 2 : 1;

	last = pos + buf.len_chars;
	if (first < 0)
	  first = pos;

	if (ret == 0 && buf.len_chars == 1 && buf.len_bytes == len_bytes)
	  memcpy (BYTE_POS_ADDR (pos_byte), buf.data, len_bytes);
	else
	  {
	    /* Replace one character with the other(s), keeping text
	       properties the same.  */
	    replace_range_2 (pos, pos_byte, pos + len_chars, pos_byte + len_bytes,
			     (const char *) buf.data, buf.len_chars,
			     buf.len_bytes,
			     0);
	    added += buf.len_chars - len_chars;
	    if (opoint > pos)
	      opoint += buf.len_chars - len_chars;
	  }

	/* FALL THOUGH */
      case RES_NO_CHANGE:
	size -= len_chars;
	pos += buf.len_chars;
	pos_byte += buf.len_bytes;
      }
    }

  if (PT != opoint)
    TEMP_SET_PT_BOTH (opoint, CHAR_TO_BYTE (opoint));

  *startp = first;
  *endp = last;
  return added;
}

/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.  b and
   e specify range of buffer to operate on.  Return character position of the
   end of the region after changes.  */
static ptrdiff_t
casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
  ptrdiff_t added;
  struct casing_context ctx;

  validate_region (&b, &e);
  ptrdiff_t start = XFASTINT (b);
  ptrdiff_t end = XFASTINT (e);
  if (start == end)
    /* Not modifying because nothing marked.  */
    return end;
  modify_text (start, end);
  prepare_casing_context (&ctx, flag, true);

  ptrdiff_t orig_end = end;
  record_delete (start, make_buffer_string (start, end, true), false);
  if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
    {
      record_insert (start, end - start);
      added = do_casify_unibyte_region (&ctx, &start, &end);
    }
  else
    {
      ptrdiff_t len = end - start, ostart = start;
      added = do_casify_multibyte_region (&ctx, &start, &end);
      record_insert (ostart, len + added);
    }

  if (start >= 0)
    {
      signal_after_change (start, end - start - added, end - start);
      update_compositions (start, end, CHECK_ALL);
    }

  return orig_end + added;
}

DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
       doc: /* Convert the region to upper case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'.  */)
  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
  Lisp_Object bounds = Qnil;

  if (!NILP (region_noncontiguous_p))
    {
      bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
		      intern ("bounds"));

      while (CONSP (bounds))
	{
	  casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
	  bounds = XCDR (bounds);
	}
    }
  else
    casify_region (CASE_UP, beg, end);

  return Qnil;
}

DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3,
       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
       doc: /* Convert the region to lower case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.  */)
  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
  Lisp_Object bounds = Qnil;

  if (!NILP (region_noncontiguous_p))
    {
      bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
		      intern ("bounds"));

      while (CONSP (bounds))
	{
	  casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
	  bounds = XCDR (bounds);
	}
    }
  else
    casify_region (CASE_DOWN, beg, end);

  return Qnil;
}

DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
       doc: /* Convert the region to capitalized form.
This means that each word's first character is converted to either
title case or upper case, and the rest to lower case.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
  (Lisp_Object beg, Lisp_Object end)
{
  casify_region (CASE_CAPITALIZE, beg, end);
  return Qnil;
}

/* Like Fcapitalize_region but change only the initials.  */

DEFUN ("upcase-initials-region", Fupcase_initials_region,
       Supcase_initials_region, 2, 2, "r",
       doc: /* Upcase the initial of each word in the region.
This means that each word's first character is converted to either
title case or upper case, and the rest are left unchanged.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
  (Lisp_Object beg, Lisp_Object end)
{
  casify_region (CASE_CAPITALIZE_UP, beg, end);
  return Qnil;
}

static Lisp_Object
casify_word (enum case_action flag, Lisp_Object arg)
{
  CHECK_NUMBER (arg);
  ptrdiff_t farend = scan_words (PT, XINT (arg));
  if (!farend)
    farend = XINT (arg) <= 0 ? BEGV : ZV;
  SET_PT (casify_region (flag, make_number (PT), make_number (farend)));
  return Qnil;
}

DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
       doc: /* Convert to upper case from point to end of word, moving over.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, convert previous words but do not move.
See also `capitalize-word'.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_UP, arg);
}

DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
       doc: /* Convert to lower case from point to end of word, moving over.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, convert previous words but do not move.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_DOWN, arg);
}

DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
       doc: /* Capitalize from point to the end of word, moving over.
With numerical argument ARG, capitalize the next ARG-1 words as well.
This gives the word(s) a first character in upper case
and the rest lower case.

If point is in the middle of a word, the part of that word before point
is ignored when moving forward.

With negative argument, capitalize previous words but do not move.  */)
  (Lisp_Object arg)
{
  return casify_word (CASE_CAPITALIZE, arg);
}

void
syms_of_casefiddle (void)
{
  DEFSYM (Qidentity, "identity");
  DEFSYM (Qtitlecase, "titlecase");
  DEFSYM (Qspecial_uppercase, "special-uppercase");
  DEFSYM (Qspecial_lowercase, "special-lowercase");
  DEFSYM (Qspecial_titlecase, "special-titlecase");

  defsubr (&Supcase);
  defsubr (&Sdowncase);
  defsubr (&Scapitalize);
  defsubr (&Supcase_initials);
  defsubr (&Supcase_region);
  defsubr (&Sdowncase_region);
  defsubr (&Scapitalize_region);
  defsubr (&Supcase_initials_region);
  defsubr (&Supcase_word);
  defsubr (&Sdowncase_word);
  defsubr (&Scapitalize_word);
}

void
keys_of_casefiddle (void)
{
  initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
  Fput (intern ("upcase-region"), Qdisabled, Qt);
  initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
  Fput (intern ("downcase-region"), Qdisabled, Qt);

  initial_define_key (meta_map, 'u', "upcase-word");
  initial_define_key (meta_map, 'l', "downcase-word");
  initial_define_key (meta_map, 'c', "capitalize-word");
}
